perm filename MKVIC.FAI[CAR,BGB] blob
sn#013959 filedate 1972-11-23 generic text, type T, neo UTF8
00100 TITLE MKVIC - MAKE A VIDEO INTENSITY CONTOUR - AUGUST 1972.
00200 COMMENT/
00300
00400 MEMORY:
00500 TVBUF 216 lines of 288 columns.
00600 PAC 1728 words - 62208 bits.
00700 HSEG 1729 words.
00800 VSEG 1736 words.
00900
01000 PROCESS:
01100
01200 TVDSKI TV file DSK input.
01300 TVDSKO TV file DSK output.
01400 TVCAMI TV camera input.
01500
01600 MKVICS make video intensity contours.
01700 MKVIC make a single contour.
01800
01900 THRESHOLD Generate 1-bit Image.
02000 PACXOR Rook's move exclusive OR'ing.
02100
02200 PIXPTR TV picture byte pointer.
02300 VICONT contrast of contours.
02400 ARCONT ARC segment Contrast.
02500
02600 MKARCS Make Arcs - width proportional to constrast.
02700
02800 FARCL Fit Arcs Linear.
02900 SPLARC Spline Arcs Fit.
03000
03100 /
03200
03300
03400
03500 ; RPEV - LINK NAMES.
03600
03700 DEFINE CW (A,Q){CAR A,1(Q)} ↔ DEFINE CCW (A,Q){CDR A,1(Q)}
03800 DEFINE CW.(A,Q){DIP A,1(Q)} ↔ DEFINE CCW.(A,Q){DAP A,1(Q)}
03900 DEFINE ARC(A,Q){CDR A,0(Q)} ↔ DEFINE ARC.(A,Q){DAP A,0(Q)}
04000 DEFINE ROW(A,Q){CAR A,-1(Q)}↔ DEFINE COL (A,Q){CDR A,-1(Q)}
04100
04200 ; ROW-COL FIXED POINT 0000.00 OPERATIONS.
04300 OPDEF FLO[FSC 225]
00100 HEADER: BLOCK =10
00200 TVBUF: BLOCK =10368
00300 PAC: BLOCK =1728
00400 VSEG: BLOCK =1729
00500 HSEG: BLOCK =1736
00600 ISAVED: 0
00700
00800 INTERN FLGSIX↔FLGSIX: -1 ;FLAG -1 FOR SIX BIT TV, 0 FOR FOUR BIT TV.
00900 INTERN VCUT↔VCUT: 14;VERTEX CONTRAST THRESHOLD.
01000
01100 ;ARC WIDTH PROPORTIONAL TO CONTRAST TABLE FOR MKARCS.
01200 ARCWID:
01300 FOR I←0,12{6.0↔}
01400 FOR I←13,17{2.0↔}
01500 FOR I←20,37{1.0↔}
01600 FOR I←40,77{0.7↔}
01700 0
01800
01900 ;WINDOW FRAME POLYGON.
02000 INTERN PGON0
02100 PGON0: .+2
02200 BEGIN
02300 4↔ 0↔XWD W,0↔XWD .-2,.-2 ;PGON BLOCK.
02400 0↔ W: 0↔XWD NW,SW↔0
02500 0↔ S: 0↔XWD SW,SE↔0
02600 0↔ E: 0↔XWD SE,NE↔0
02700 0↔ N: 0↔XWD NE,NW↔0
02800
02900 0↔ NW: 0↔ XWD N,W↔0
03000 =216B11↔ SW: 0↔ XWD W,S↔0
03100 =216B11 + =288B29↔ SE: 0↔ XWD S,E↔0
03200 =288B29↔ NE: 0↔ XWD E,N↔0
03300
03400 BEND
00100 ;RINGIN(E,R,N) - RING IN E JUST LEFT OF R AT Nth WORD.
00200 SUBR RINGIN
00300 BEGIN RINGIN
00400 ACCUMULATORS{Q,E,R}
00500 CDR E,ARG3
00600 CDR R,ARG2
00700 LAC ARG1
00800 DAP .+1↔CDR Q,(E)↔JUMPE Q,L
00900 CAME Q,E↔RET3; E AIN'T EMPTY.
01000 L: DAP .+1↔CAR Q,(R)
01100 DAP .+1↔DAP E,(Q)
01200 DAP .+1↔DIP E,(R)
01300 DAP .+1↔DIP Q,(E)
01400 DAP .+1↔DAP R,(E)
01500 RET3
01600 BEND
01700
01800 ;RINGO(E,N) - RING OUT E AT Nth WORD - LEAVE E LEGALLY EMPTY.
01900 SUBR RINGO
02000 BEGIN RINGO
02100 ACCUMULATORS{Q,E,R}
02200 CDR ARG1↔CDR E,ARG2
02300 DAP .+1↔CAR Q,(E)↔JUMPE Q,L
02400 DAP .+1↔CDR R,(E)
02500 DAP .+1↔DAP R,(Q)
02600 DAP .+1↔DIP Q,(R)
02700 L: SLAP E,E
02800 DAP .+1↔DAC E,(E)
02900 RET2
03000 BEND
03100
03200 ;EMPTY(E,N) - RETURNS TRUE WHEN RING IS EMPTY.
03300 SUBR(EMPTY)
03400 BEGIN EMPTY
03500 CDR ARG1
03600 CDR 1,ARG2
03700 DAP .+1↔CDR (1)
03800 SKIPN↔RET2
03900 CAME 1↔SETZ 1,↔RET2
04000 BEND
00100 FILNAM: 0 ;FILE NAME.
00200 EXTION: 0 ;EXTENSION.
00300 0
00400 PPPN: 0 ;PROJECT-PROGRAMMER.
00500
00600
00700 ;INPUT A TELEVISION PICTURE FROM A DISK FILE.
00800 SUBR(TVDSK)
00900 BEGIN TVDSK
01000
01100 ;DEFAULT FILE SPECIFICATION.
01200 SKIPN 1,PPPN↔LAC 1,[SIXBIT/DATBGB/]↔DAC 1,PPPN
01300 SKIPN 1,EXTION↔LAC 1,[SIXBIT/TMP/]↔DAC 1,EXTION
01400 SKIPN 1,FILNAM↔LAC 1,[SIXBIT/X/]↔DAC 1,FILNAM
01500
01600 INIT 1,17↔SIXBIT/DSK/↔0↔HALT
01700 LOOKUP 1,FILNAM↔HALT
01800 IN 1,[IOWD =10378,HEADER↔0]↔JFCL
01900 RELEASE 1,
02000 OUTSTR[ASCIZ" EOF"]
02100 SETZM FILNAM↔SETZ EXTION↔SETZM EXTION+1↔SETZM PPPN
02200 POP0J
02300 BEND
00100 TVPTR: XWD -=6912,TVBUF
00200 TVCLIP: 701002 ;BCLIP=7 TCLIP=0 CAM=1.
00300 TVYXW: BYTE(9)50,34,40
00400 TVERR: 0
00500
00600 ;INPUT A TELEVISION PICTURE FROM A CAMERA.
00700 ;TVCAM(CAMERA).
00800 SUBR(TVCAM)
00900 BEGIN TVCAM
01000 SETZM FLGSIX
01100 SAVAC(17)
01200 TVTAKE: INIT 17,17↔SIXBIT/TV/↔0
01300 GO[OUTSTR[ASCIZ"CAN'T INIT TV."]↔INCHRW↔GO .-3]
01400
01500 SETZM TVERR↔INPUT 17,TVPTR↔MOVE 1,TVERR
01600 TRNE 1,100060↔GO .-4
01700 RELEASE 17,
01800
01900 ; REPORT ON THE ERROR BITS AND RETAKE IF NECESSARY;
02000 TRNE 1,100000↔OUTSTR [ASCIZ/TV PARITY ERROR.
02100 /]↔ TRNE 1,40 ↔OUTSTR [ASCIZ/TV DATA MISS.
02200 /]↔ TRNE 1,20 ↔OUTSTR [ASCIZ/TV NON EX MEM.
02300 /]↔ TRNE 1,100060↔JRST TVTAKE
02400 ; TIME AND DATE.
02500 CALLI 22↔MOVEM TVTIME#
02600 CALLI 14↔MOVEM TVDATE#
02700 ; CONVERT FROM GREY CODE TO GRAY CODE.
02800 HRLZI 16,[
02900 SETCM 17,(16) ;0
03000 MOVE 15,17 ;1
03100 LSH 15,-1 ;2
03200 AND 15,13 ;3
03300 XORB 17,15 ;4
03400 LSH 15,-2 ;5
03500 AND 15,14 ;6
03600 XOR 17,15 ;7
03700 MOVEM 17,(16) ;10
03800 AOBJN 16, ;11
03900 JRST ;12
04000 BYTE (4)7,7,7,7,7,7,7,7,7
04100 BYTE (4)3,3,3,3,3,3,3,3,3
04200 ]
04300 BLT 16,14
04400 LAC 16,TVPTR
04500 HRRI 12,.+2
04600 JRST
04700 GETAC(17)
04800 POP0J
04900 BEND
00100 ;MAKE VIDEO INTENSITY CONTOURS.
00200 SUBR(MKVICS)
00300 BEGIN MKVICS
00400 LAC 1,ARG2↔DAC 1,Q0#
00500 LAC 1,ARG1↔ANDCMI 1,377↔DAC 1,Q1#
00600 SETZM LEVEL#
00700
00800 ;FIND AN INTENSITY CONTOUR ENABLE BIT OR EXIT.
00900 L0: LAC 0,Q0↔LAC 1,Q1
01000 L1: AOS 2,LEVEL↔LSHC 0,1↔JUMPL L2
01100 SKIPE 0↔GO L1↔SKIPE 1↔GO L1↔POP2J
01200 L2: DAC 0,Q0↔DAC 1,Q1
01300
01400 ;MAIN VIC CREATION SEQUENCE.
01500 PUSH P,LEVEL
01600 PUSHJ P,THRESH
01700 PUSHJ P,PACXOR
01800 L3: PUSHJ P,MKVIC ;Make a single contour loop.
01900 JUMPE 1,L0 ;no more contours at this level.
02000 DAC 1,P1#
02100 PUSH P,1
02200 PUSHJ P,VICONT ;VIC-CONTRAST.
02300
02400 ;Eliminate Insignificant Contours - small low contrast.
02500 LAC 1,P1
02600 LACM -1(1)
02700 CAIL =10↔GO .+4
02800 PUSH P,P1↔PUSHJ P,KLPGON↔GO L3
02900
03000 ;Smooth VIC into a loop of ARC segments.
03100 PUSHJ P,MKPAP ;Proto Arc Polygon.
03200 DAC 1,P2#
03300 CAR 2,1(1) ;PED(P2)
03400 CAR 1,1(2)↔DAC 1,V1#
03500 CDR 1,1(2)↔DAC 1,V2#
03600 PUSH P,V1↔PUSH P,V2↔PUSHJ P,MKARCS
03700 PUSH P,V2↔PUSH P,V1↔PUSHJ P,MKARCS
03800 ;PUSH P,P2↔;PUSHJ P,FARCL
03900 ;PUSH P,P2↔;PUSHJ P,ARCONT
04000 PUSH P,P1↔PUSHJ P,KLPGON
04100 ;PUT P2 INTO THE PGON-RING.
04200 LAC 1,P2 ↔ LAC 2,PGON0 ↔ CAR 3,2(2)
04300 DIP 3,2(1)↔DAP 1,2(3)
04400 DAP 2,2(1)↔DIP 1,2(2)
04500 GO L3
04600 BEND
00100 ;MKVIC - MAKE A VIDEO INTENSITY CONTOUR - AUGUST 1972.
00200 ;PGON ← MKVIC;
00300 SUBR(MKVIC)
00400 BEGIN MKVIC
00500
00600 ACCUMULATORS{A2,A3,RC,MASK,I,PTR,D,E,A12,V}
00700 LAC I,ISAVED
00800 CDR PTR,ARG1
00900 SLIMZ I↔HRRI PAC↔DAC PACPTR#; PAC POINTER INDEXED BY I.
01000
01100 ;FIND THE ROW & COL OF THE UPPER LEFT MOST VSEG.
01200 L1: SKIPE 1,VSEG(I)↔GO L2
01300 AOS I↔CAIE I,=1728↔GO L1
01400 SETZ 1,↔RET0;EMPTY.
01500
01600 L2: DAC I,ISAVED↔JFFO 1,.+1↔SLIMZ MASK,400000
01700 MOVNS 2↔LSH MASK,(2)↔MOVNS 2
01800 LAC RC,I↔ANDI RC,7↔IMULI RC,=36↔ADD RC,2 ;COLUMN.
01900 LAC I↔LSH -3↔DIP RC↔LSH RC,6 ;ROW.
02000
02100 ;DISTINGUISH BLOBS FROM HOLES.
02200 SETZM HOLE#
02300 TDNN MASK,@PACPTR; HOLE OR BLOB ?
02400 SETOM HOLE#;HOLE'A'COMING.
02500
02600 ;...AND HEAD SOUTH.
02700 DAC RC,RCMIN#↔SETZM RCMAX#↔SETZ V,↔SETZM ECNT#
02800 PUSHJ P,FOLLOW↔LAC V,V0↔CCW. V,E↔CW. E,V
02900 ;MAKE & RETURN VIC POLYGON.
03000 CALL GETBLK↔DAC 1,PTR
03100 LAC 1,ECNT↔SKIPE HOLE#↔MOVNS 1 ; -CNT INDICATES A HOLE.
03200 DAC 1,-1(PTR)↔CCW E,V↔DIP E,1(PTR)↔LAC 1,PTR
03300 L3: RET0
03400
00100 ;THE SUB-OPERATIONS OF MKVIC.
00200
00300 DEFINE TRY (SEG,YES) {
00400 LAC SEG(I)↔TDZN MASK↔GO .+3↔DAC SEG(I)↔GO YES}
00500 DEFINE LEFT {SUBI RC,100↔ROT MASK,1↔CAIN MASK,1↔SOS I}
00600 DEFINE RIGHT {ADDI RC,100↔ROT MASK,-1↔SKIPG MASK↔AOS I}
00700 DEFINE UP {SUB RC,[1B11]↔SUBI I,8}
00800 DEFINE DOWN {ADD RC,[1B11]↔ADDI I,8}
00900 DEFINE DEL $ (A,B){LAC D,[XWD 0$A$30,0$B$30]}
01000
01100 ;CREATE NEW EDGE AND VERTEX OF A VIC.
01200 TURN: 0
01250 AOS TURNS#
01300 ADD D,RC
01400 AOS 2,ECNT
01500
01600 ;VERTEX
01700 CALL GETBLK
01800 SKIPN V↔GO[DAC 1,V0#↔DAC 1,V↔GO T2]
01900 DAC 1,V↔DIP 2,(V)
02000 CCW. V,E↔CW. E,V
02100 T2: DAC D,-1(V)
02200 CAMLE D,RCMAX
02300 GO[DAC D,RCMAX↔DAC V,V1#↔GO .+1]
02400
02500 ;EDGE
02600 CALL GETBLK
02700 DAC 1,E↔DIP 2,(E)
02800 CCW. E,V↔CW. V,E
02900 GO @TURN
03000
03100 ;MAKE PROTO ARC POLYGON USING V0 AND V1.
03200 SUBR(MKPAP)
03300 AV1←MASK↔AV2←I
03400 CALL GETBLK↔DAC 1,PTR
03500 CALL GETBLK↔DAC 1,E
03600 CALL GETBLK↔DAC 1,D
03700 CALL GETBLK↔DAC 1,AV1↔LAC 1,V0↔ARC. 1,AV1↔ARC. AV1,1
03800 LAC -1(1)↔DAC -1(AV1)
03900 CCW. E,AV1↔CW. AV1,E↔CCW. AV1,D↔CW. D,AV1
04000 CALL GETBLK↔DAC 1,AV2↔LAC 2,V1↔ARC. 2,AV2↔ARC. AV2,2
04100 LAC -1(2)↔DAC -1(AV2)
04200 CCW. D,AV2↔CW. AV2,D↔CCW. AV2,E↔CW. E,AV2
04300 DIP E,1(PTR)↔LAC 1,PTR↔RET0
00100 ;THE ALCHEMIST OF MKVIC -
00200 ; - convert lead into golden line segments.
00300
00400 NORTH: ADD D,[1B11]↔JSR TURN
00500 NORTH2: LEFT↔DEL(+,-)↔ TRY HSEG,WEST
00600 RIGHT↔UP↔ TRY VSEG,NORTH2
00700 DOWN↔DEL(+,+)↔ TRY HSEG,EAST↔FATAL(NORTH)
00800 NORTH3: JSR TURN↔LEFT
00900 NORTH4: UP↔DEL(+,-)↔ TRY HSEG,WEST↔GO NORTH4
01000
01100
01200 WEST: ADDI D,100↔JSR TURN
01300 WEST2: CAMN RC,RCMIN↔POPJ P,;TRY FOR E.O.VIC.
01400 FOLLOW: DEL(+,+)↔ TRY VSEG,SOUTH
01500 LEFT↔ TRY HSEG,WEST2
01600 RIGHT↔UP↔DEL(-,+)↔TRY VSEG,NORTH↔FATAL(WEST)
01700
01800
01900 SOUTH: JSR TURN
02000 SOUTH2: DOWN↔DEL(-,+)
02100 CAR RC↔CAIN =216B29↔GO EAST3
02200 TRY HSEG, EAST
02300 TRY VSEG,SOUTH2
02400 LEFT↔DEL(-,-)↔ TRY HSEG,WEST↔ FATAL(SOUTH)
02500
02600
02700 EAST: JSR TURN
02800 EAST2: RIGHT↔DEL(-,-)
02900 CDR RC↔CAIN =288B29↔GO NORTH3
03000 UP↔ TRY VSEG,NORTH
03100 DOWN↔ TRY HSEG,EAST2
03200 DEL(+,-)↔ TRY VSEG,SOUTH↔FATAL(EAST)
03300 EAST3: JSR TURN↔UP
03400 EAST4: RIGHT↔DEL(-,-)
03500 CDR RC↔CAIN =288B29↔GO[DOWN↔GO NORTH3]
03600 TRY VSEG,NORTH↔GO EAST4
03700 BEND
00100 ;PACXOR - Do rook's exclusive OR'ing.
00200 SUBR(PACXOR)
00300 BEGIN PACXOR
00400 I←2
00500 MOVSI PAC↔LIM HSEG↔BLT HSEG+=1727
00600 MOVSI PAC↔LIM VSEG↔BLT VSEG+=1727
00700 SETZ I,
00800 HRRI PAC↔DAP L+2
00900 L: TRNN I,7↔SETZ 1,↔LAC PAC(I)
01000 XORM HSEG+8(I) ; HSEG bits are above PAC bits.
01100 ROTC -1↔ROT 1,1
01200 XORM VSEG(I) ; VSEG are left of PAC bits.
01300 AOS I
01400 CAIE I,=1728
01500 GO L
01600 SETZM ISAVED
01700 RET0
01800 BEND
00100 ;CHEAP AD HOC DYNAMIC FREE STORAGE ROUTINES.
00200 EXTERN CORGET;
00300 CORSIZ: 0
00400 NIL←777777
00500 AVAIL: NIL
00600 ; PTR ← GETBLK;
00700 GETBLK:
00800 BEGIN GETBLK
00900 ACCUMULATORS{PTR,SIZ}
01000 CDR 1,AVAIL
01100 CAIN 1,NIL↔GO L1
01200 CDR (1)↔DAP AVAIL
01300 SETZM 0(1)↔SETZM 1(1)↔SETZM 2(1)↔SETZM 3(1)
01400 MOVEI 4↔ADDM CORSIZ
01500 ADDI 1,1↔RET0
01600 ;GET A BIG BLOCK FROM SAIL.
01700 L1: LAC [XWD 2,AC2]↔BLT AC15
01800 MOVEI 3,=4096
01900 CALL CORGET
02000 GO[FATAL(NO MORE CORE.)]
02100 MOVEI NIL↔DAP (2)↔SUBI 3,4
02200 L2: LAC 2↔ADDI 2,4↔DAP(2)↔SUBI 3,4↔JUMPN 3,L2
02300 DAP 2,AVAIL
02400 LAC [XWD AC2,2]↔BLT 15
02500 GO GETBLK
02600 BEND
02700
02800 ;RELBLK(PTR);
02900 RELBLK:
03000 BEGIN RELBLK
03100 LAC 1,ARG1↔SUBI 1,1
03200 SETZM 0(1)↔SETZM 1(1)↔SETZM 2(1)↔SETZM 3(1)
03300 LAC 2,AVAIL↔DAP 2,(1)↔DAP 1,AVAIL
03400 NIM -4↔ADDM CORSIZ
03500 RET1
03600 BEND
03700
03800 ;KLPGON(P)
03900 SUBR(KLPGON)
04000 BEGIN KLPGON
04100 ACCUMULATORS{A2,PGN,E0,Q,R}
04200 LAC PGN,ARG1
04300 CAR E0,1(PGN)
04400 CALL RELBLK,PGN
04500 DAC E0,Q
04600 L: CCW R,Q
04700 CALL RELBLK,Q
04800 CAMN R,E0↔RET1
04900 DAC R,Q↔GO L
05000 BEND
00100 ;THRESHOLD(CUT) - pre-Foonly Version.
00200 SUBR(THRESH)
00300 BEGIN THRESH
00400 I←13 ↔ J←14 ↔ PTR←15
00500 LAC [XWD L,2]↔BLT 11
00600 LAP 4,ARG1↔SLIMZ I,-=1728
00700 HRLZI PTR,440600 ; =36 BITS TO GO, 6 BITS PER BYTE.
00800 SKIPN FLGSIX↔ HRLZI PTR,440400 ; 4 BITS PER BYTE.
00900 HRRI PTR,TVBUF
01000 HRRI 7,PAC↔GO 2
01100
01200 ;ACCUMULATOR LOOP.
01300 L: MOVEI J,=36 ;2
01400 ILDB PTR ;3
01500 SUBI ;CUT ;4
01600 ROTC 1 ;5
01700 SOJG J,3 ;6
01800 SETCAM 1,PAC(I) ;7
01900 AOBJN I,2 ;10
02000 POP1J ;11
02100 BEND
02200
02300 SUBR(HISTOGRAM)
02400 BEGIN HISTOGRAM
02500 EXTERN HISTO
02600 PTR←15
02700
02800 LAC 1,HISTO↔SETZM(1) ;CLEAR HISTOGRAM.
02900 HRLZ 1↔ADDI 1(1)↔BLT =65(1)
03000
03100 LAC[XWD L,2]↔BLT 5
03200
03300 HRLZI PTR,440600↔SKIPN FLGSIX
03400 HRLZI PTR,440400↔HRRI PTR,TVBUF
03500 MOVEI =62208 ;NUMBER OF PIXELS IN A PICTURE.
03600 ADD 3,HISTO ;HISTOGRAM POINTER.
03700 JRST 2
03800
03900 ;ACCUMULATOR LOOP.
04000 L: ILDB 1,PTR ;2
04100 AOS 1(1) ;3
04200 SOJG 2 ;4
04300 POP1J ;5
04400 BEND
00100 ;PTR ← PIXPTR(ROW,COL) - COMPUTE PICTURE BYTE POINTER.
00200 SUBR(PIXPTR)
00300 BEGIN PIXPTR
00400 ;AC-0 PC return address for JSP entry.
00500 ;AC-1 Row argument, byte pointer value.
00600 ;AC-2 Column argument.
00700 ;AC-3 get clobbered.
00800 SETZ↔LAC 1,ARG2↔LAC 2,ARG1
00900 ;PIXPTR+3:
01000 SKIPN FLGSIX↔JRST L
01100 ;SIX BIT BYTES - TVBUF + ROW*48 + (COL DIV 6).
01200 IMULI 1,=48
01300 ADDI 1,TVBUF
01400 IDIVI 2,6
01500 ADD 1,2
01600 HLL 1,[POINT 6,0,-1 ↔ POINT 6,0,05 ↔ POINT 6,0,11
01700 POINT 6,0,17 ↔ POINT 6,0,23 ↔ POINT 6,0,29](3)
01800 JUMPN@↔POP2J
01900 ;FOUR BIT BYTES - TVBUF + ROW*32 + (COL DIV 9).
02000 L: ASH 1,5
02100 ADDI 1,TVBUF
02200 IDIVI 2,9
02300 ADD 1,2
02400 HLL 1,[POINT 4,0,-1 ↔ POINT 4,0,03 ↔ POINT 4,0,07
02500 POINT 4,0,11 ↔ POINT 4,0,15 ↔ POINT 4,0,19
02600 POINT 4,0,23 ↔ POINT 4,0,27 ↔ POINT 4,0,31]
02700 JUMPN@↔POP2J
02800 BEND
00100 ;VICONTRAST(PGON) - HORIZONTAL/VERTICAL CONTRAST.
00200 SUBR(VICONT)
00300 BEGIN VICONT
00400 R←1 ↔ C←2 ↔ R2←10 ↔ C2←11 ↔ E←13 ↔ V1←14 ↔ V2←15
00500
00600 ;INITIALIZATION - SETUP FIRST EDGE OF THE PGON.
00700
00800 LAC E,ARG1 ↔ CAR E,1(E) ↔ DAC E,E0# ↔ CW V2,E
00900 LAC -1(V2)↔ADD [XWD 30,30]
01000 CAR R2,↔LSH R2,-6 ↔ CDR C2,↔LSH C2,-6
01100
01200 ;ADVANCE CCW ALONGPGON.
01300
01400 L0: DAC V2,V1 ↔ DAC R2,R1# ↔ DAC C2,C1# ↔ CCW V2,E
01500 LAC -1(V2)↔ADD [XWD 30,30]
01600 CAR R2,↔LSH R2,-6 ↔ CDR C2,↔LSH C2,-6
01700
01800 ;SELECT HORIZONTAL OR VERTICAL.
01900
02000 CAMN R2,R1 ↔ JRST HORZNT
02100 CAMN C2,C1 ↔ JRST VERTCL
02200 OUTSTR[ASCIZ/VICONT ¬HV./]
02300 L1: CCW E,V2↔CAME E,E0↔JRST L0
02400
02500 ;VERTEX CONTRAST.
02600 L2: NAP 0,-1(E)
02700 CCW V1,E
02800 CCW E,V1
02900 NAP 1,-1(E)
03000 SUB 1,0↔DAP 1,2(V1)
03100
03200 NAP 1,-1(E)↔MOVMS↔MOVMS 1↔CAMG 0,1↔EXCH 0,1
03300 SETO 2,↔CAML 0,VCUT↔CAML 1,VCUT↔SETZ 2,
03400 DIP 2,2(V1) ;MARK TRANSITIONAL VERTEX.
03500
03600 CAME E,E0↔JRST L2↔POP1J
00100 ;HORIZONTAL CASE LEFT TO RIGHT.
00200 HORZNT:
00300 LAC R,R1
00400 LAC C,C1 ↔ LAC 5,C2
00500 CAML C,C2 ↔ EXCH C,5 ;GET FAR LEFT IN C.
00600 LAC 6,C ↔ SUB 5,C ;COLUMN DIFFERENCE.
00700
00800 ;SETUP TVBUF BYTE POINTERS 1 INSIDE, 3 OUTSIDE.
00900 JSP PIXPTR+3↔LAC 3,1
01000 SUBI 1,=32 ↔ SKIPE FLGSIX ↔ SUBI 1,=16
01100 CAME 6,C1 ↔ EXCH 1,3 ↔ LAC 6,5
01200
01300 ;ACCUMULATE INTENSITIES ALONG THE EDGE.
01400 SETZB 2,4↔ILDB 1↔ADDM 2↔ILDB 3↔ADDM 4↔ SOJG 5,.-4
01500
01600 ;SET ABOVE THE TOP OR BELOW THE BOTTOM TO UTTER DARKNESS.
01700 SKIPE R2↔CAIN R2,=216↔SETZ 4,
01800
01900 ;COMPUTE AND SAVE AVERAGE INTENSITIES AND CONTRAST.
02000 IDIV 2,6↔DIP 2,2(E) ;INSIDE CCW V1 TO V2.
02100 IDIV 4,6↔DAP 4,2(E) ;OUTSIDE CW V1 TO V2.
02200 SUB 2,4↔DAP 2,-1(E) ;CONTRAST INSIDE MINUS OUTSIDE.
02300 DIP 6,-1(E)↔ JRST L1
02400
02500 ;VERTICAL CASE TOP TO BOTTOM.
02600 VERTCL:
02700 LAC C,C1 ↔ LAC R,R1 ↔ LAC 5,R2
02800 CAML R,R2 ↔ EXCH R,5 ;GET UPPERMOST ROW.
02900 LAC 6,R ↔ SUB 5,R ;ROW DIFFERENCE.
03000
03100 ;SETUP TVBUF BYTE POINTERS 1 INSIDE, 3 OUTSIDE.
03200 JSP PIXPTR+3↔TLO 1,7↔LAC 3,1 ;INDEXED BY AC-7.
03300 IBP 1 ↔ TLC 3,(44B5) ;FLIP 'EM.
03400 TLNN 3,(44B5)↔SOSA 3 ;DECREM BYTE POINTER.
03500 TLC 3,(44B5) ;STATUS QUO ANTE.
03600 CAME 6,R1 ↔ EXCH 1,3 ↔ LAC 6,5
03700
03800 ;ACCUMULATE INTENSITIES ALONG THE EDGE.
03900 SETZB 2,4↔SETZ 7,
04000 MOVEI =32↔SKIPE FLGSIX↔MOVEI =48↔DAP .+5 ;ROW WORD WIDTH.
04100 LDB 1↔ADDM 2↔LDB 3↔ADDM 4↔ADDI 7,0↔ SOJG 5,.-5
04200
04300 ;SET BEYOND THE LEFT OR RIGHT TO UTTER DARKNESS.
04400 SKIPE C2↔CAIN C2,=288↔SETZ 4,
04500
04600 ;COMPUTE AND SAVE AVERAGE INTENSITIES AND CONTRAST.
04700 IDIV 2,6↔DIP 2,2(E) ;INSIDE CCW V1 TO V2.
04800 IDIV 4,6↔DAP 4,2(E) ;OUTSIDE CW V1 TO V2.
04900 SUB 2,4↔DAP 2,-1(E) ;CONTRAST INSIDE MINUS OUTSIDE.
05000 DIP 6,-1(E)↔ JRST L1 ↔ LIT↔VAR
05100 BEND
00100 ; ARC CONTRAST.
00200 SUBR(ARCONT)
00300 BEGIN ARCONT
00400 ACCUMULATORS{U1,U2,V1,V2,E,E0,N}
00500
00600 LAC E,ARG1 ;FIRST EDGE OF AN ARC PGON.
00700 CAR E,1(E)
00800 DAC E,E0
00900 CW V2,E
01000
01100 L1: LAC V1,V2↔CCW V2,E
01200 ARC U1,V1↔ARC U2,V2
01300
01400 SETZ↔MOVEI N,1
01500
01600 CCW U1,U1↔ADD 2(U1)↔CCW U1,U1
01700 CAME U1,U2↔AOJA N,.-4
01800
01900 CAR 2,0 ↔ IDIV 2,N ↔ DIP 2,2(E)
02000 CDR 0,0 ↔ IDIV 0,N ↔ DAP 0,2(E)
02100 SUB 2,0 ↔ DAP 2,-1(E)
02200
02300 CCW E,V2↔CAME E,E0↔JRST L1
02400
02500 ;VERTEX CONTRAST.
02600 L2: NAP 0,-1(E)↔CCW V1,E
02700 CCW E,V1↔NAP 1,-1(E)
02800 SUB 1,0↔DAP 1,2(V1)
02900
03000 NAP 1,-1(E)↔MOVMS↔MOVMS 1
03100 CAMG 0,1↔EXCH 0,1
03200 SETO 2,↔CAML 0,VCUT↔CAML 1,VCUT↔SETZ 2,
03300 DIP 2,2(V1) ;MARK TRANSITIONAL VERTEX.
03400
03500 CAME E,E0↔JRST L2↔POP1J
03600 BEND
00100 ;SUBR MKARCS (ARCV1,ARCV2) - FROM U1 CCW TO U2.
00200 SUBR(MKARCS)
00300 BEGIN MKARCS
00400 EXTERN SQRT; CLOBBERS AC1 THRU AC4.
00500 ACCUMULATORS{D,U1,U2,V1,V2,A,B,C,S12,E,U,V}
00600 LAC V1,ARG2↔LAC V2,ARG1↔SETZM AVCNT#
00700
00800 ;CHECK FOR TRIVAIL CASE.
00900 L0: ARC U1,V1↔ARC U2,V2
01000 CCW E,U1↔CCW 0,E↔CAMN 0,U2↔GO L3
01100
01200 ;COMPUTE NORMALIZED ARC EDGE COEFFICIENTS.
01300 ROW A,V1↔FLO A, ; A ← Y1.
01400 COL B,V2↔FLO B, ; B ← X2.
01500 COL C,V1↔FLO C, ; C ← X1.
01600 ROW D,V2↔FLO D, ; D ← Y2.
01700 LAC 1,B↔FMPR 1,A ; 1 ← X2*Y1.
01800 FSBR A,D↔FSBR B,C ; A ← Y1-Y2. B ← X2-X1.
01900 FMPR C,D↔FSBR C,1 ; C ← X1*Y2 - X2*Y1.
02000 LAC 0,A↔FMPR 0,0↔LAC 1,B↔FMPR 1,1↔FADR 1,0
02100 CALL SQRT,1↔FDVR A,1↔FDVR B,1↔FDVR C,1
02200
00100 ;SET 'EM UP FOR AN ARC PASS.
00200 ARC U1,V1↔ARC U2,V2
00300 SETZM DMAX#↔SETZM DMIN#
00400 SETZM VMAX#↔SETZM VMIN#
00500 SETZM MAXCON#
00600 ;GO FROM U1 CCW TO U2 AND FIND THE U FURTHEST OFF THE ARC-EDGE.
00700 L1: CCW E,U1↔CCW U1,E↔CAMN U1,U2↔GO L2
00800 COL 0,U1↔FLO 0,↔ROW 1,U1↔FLO 1,
00900 FMPR 0,A↔FMPR 1,B↔LAC D,C↔FADR D,0↔FADR D,1
01000 CAMGE D,DMIN↔GO [DAC U1,VMIN↔DAC D,DMIN↔GO .+1]
01100 CAMLE D,DMAX↔GO [DAC U1,VMAX↔DAC D,DMAX↔GO .+1]
01200 ;KEEP TRACK OF MAXIMUM EDGE CONTRAST ALONG ARC.
01300 NAP 0,-1(E)↔MOVM↔CAMLE MAXCON↔DAC MAXCON↔GO L1
01400
01500 ;WHEN EXTREMA EXCEED ARCWID[MAXCON] THEN FORM ARC-POINTS.
01600 L2: LAC U,VMIN↔LACM DMIN
01700 CAMGE DMAX↔LAC U,VMAX↔CAMGE DMAX↔LAC DMAX
01800 LAC 1,MAXCON↔CAMGE ARCWID(1)↔GO L3
01900
02000 ;OLDE ESPLIT: →CW→ V2...D...AV...E...V1 ←CCW←
02100 CALL GETBLK↔DAC 1,E
02200 CALL GETBLK↔DAC 1,V↔AOS AVCNT
02300 ARC. U,V↔ARC. V,U↔LAC -1(U)↔DAC -1(V)
02400 CW D,V2↔CCW. D,V↔CW. V,D
02500 CW. E,V↔CCW. E,V1
02600 CW. V1,E↔CCW. V,E
02700 LAC V2,V↔GO L0
02800
02900 ;ADVANCE CCW AN ARC-EDGE OR EXIT.
03000 L3: CAMN V2,ARG1↔POP2J
03100 LAC V1,V2↔CCW E,V2↔CCW V2,E↔GO L0
03200 BEND
00100 ;FARCL(PGON) - FIT ARCS LINEAR.
00200 SUBR(FARCL)
00300 BEGIN FARCL
00400 X←1
00500 ACCUMULATORS{Y,SX,SY,XX,YY,XY,N,E,U1,U2,V1,V2}
00600 DAC 12,AC12
00700
00800 ;Clear the Locus of all the Arc Vertices.
00900 LAC E,ARG1↔CAR E,1(E)↔DAC E,E0#
01000 CCW V1,E ↔ SETZM -1(V1)
01100 CCW E,V1 ↔ CAME E,E0↔JRST .-4
01200
01300 ;Advance along Polygon.
01400 CW V2,E
01500 L1: LAC V1,V2↔CCW V2,E
01600 ARC U1,V1↔ARC U2,V2
01700 CW U1,U1↔CW U1,U1
01800 CW U1,U1↔CW U1,U1
01900 CW U1,U1↔CW U1,U1
02000 CCW U2,U2↔CCW U2,U2
02100 CCW U2,U2↔CCW U2,U2
02200 CCW U2,U2↔CCW U2,U2
02300
02400 ;Arc Scan Initialization.
02500 LAC [XWD SX,SY]↔SETZ SX,↔BLT N↔JRST .+3
02600 ;Advance along VIC within the ARC.
02700 L2: CCW U1,U1↔CCW U1,U1
02800 ;Accumulate a Point.
02900 CDR X,-1(U1)↔FLO X,↔CAR Y,-1(U1)↔FLO Y,
03000 FAD SX,X ↔ FAD SY,Y
03100 LAC X ↔ FMP Y ↔ FAD XY,0
03200 FMP X,X ↔ FAD XX,X
03300 FMP Y,Y ↔ FAD YY,Y
03400 CAME U1,U2↔AOJA N,L2↔AOS N
00100 ;Compute symetric least squares line coefficients.
00200 ; Q ← N*XY - SY*SX.
00300 ; A ← Q + SY*SY - N*YY.
00400 ; B ← Q + SX*SX - N*XX.
00500 ; C ← SX*YY + SY*XX - XY*(SX+SY).
00600
00700 L3: LAC 2,SX↔FMP 2,YY
00800 LAC 0,SY↔FMP 0,XX↔FAD 2,0
00900 LAC SX↔FAD SY↔FMP XY↔FSB 2,0↔DAC 2,CCCC#
01000
01100 FSC N,233↔FMP XX,N↔FMP XY,N↔FMP YY,N ;all the N terms.
01200 LAC SX↔FMP SY↔FSB XY,0 ;Q in XY.
01300
01400 FMP SY,SY↔FAD SY,XY↔FSB SY,YY↔DAC SY,AAAA#
01500 FMP SX,SX↔FAD SX,XY↔FSB SX,XX↔DAC SX,BBBB#
01600
01700 FMP SY,SY↔FMP SX,SX↔FAD SX,SY
01800 MOVSI(1.0)↔FDVR SX↔DAC QQQQ# ;PSEUDO NORMALIZATION.
01900
02000 ;Solve for the Locii where perpendiculars dropped from
02100 ;the arc-edge hit the fitted line.
02200 ; Q ← 1/(A*A + B*B).
02300 ; D ← (B*X1 - A*Y1).
02400 ; X ← (B*D - A*C)*Q.
02500 ; Y ←-(A*D + B*C)*Q.
02600
02700 L4: ARC U1,V1
02800 CDR X,-1(U1)↔FLO X,↔CAR Y,-1(U1)↔FLO Y,
02900 FMP X,BBBB↔FMP Y,AAAA↔FSBR X,Y↔LACN Y,X ;DDDD.
03000 FMP X,BBBB↔FMP Y,AAAA
03100 LAC AAAA↔FMP CCCC↔FSBR X,↔FMPR X,QQQQ↔247040226000;FIX
03200 LAC BBBB↔FMP CCCC↔FSBR Y,↔FMPR Y,QQQQ↔247100226000
03300 DIP Y,X↔ADDM X,-1(V1)
03400
03500 ARC U2,V2
03600 CDR X,-1(U2)↔FLO X,↔CAR Y,-1(U2)↔FLO Y,
03700 FMP X,BBBB↔FMP Y,AAAA↔FSBR X,Y↔LACN Y,X ;DDDD.
03800 FMP X,BBBB↔FMP Y,AAAA
03900 LAC AAAA↔FMP CCCC↔FSBR X,↔FMPR X,QQQQ↔247040226000;FIX
04000 LAC BBBB↔FMP CCCC↔FSBR Y,↔FMPR Y,QQQQ↔247100226000
04100 DIP Y,X↔ADDM X,-1(V2)
04200
04300 CCW E,V2↔CAME E,E0↔JRST L1
04400 LAC 12,AC12↔POP1J
04500 BEND
00100 END